---
title: "Norm abandonment"
output:
  html_document: default
  pdf_document: default
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(kableExtra)
library(car)
library(knitr)
library(broom.mixed)
library(officer)
library(readxl)
library(haven) 
library(tidyverse) 
library(e1071) 
library(xtable)
library(tinytex)
library(gridExtra)
library(stargazer)
library(lme4)
library(modelsummary)
library(plm)
library(lmtest)
library(patchwork)
library(ggplot2)
library(dplyr)
library(ggrepel)
library(clinfun)
library(margins)

```

```{r}
#Examples of 3 division norms (Figure 2)
v1=100
v2=400
M=2000
ver=c(M/2,(M-v1-v2)/2+v1,M*v1/(v1+v2),v1)
hor=c(M/2,(M-v1-v2)/2+v2,M*v2/(v1+v2),v2)
Legend=c("Norm ED","Norm EG","Norm PD","Disagreement point")

plot<-data.frame(ver,hor,Legend)
ggplot(plot, aes(x=hor,y=ver,color=Legend)) +theme_bw()+scale_x_continuous(limits=c(0,2000),expand=c(0,0), breaks =c(0,400,1000,1150,1600,2000))+scale_y_continuous(limits=c(0,2000),expand=c(0,0),breaks =c(100,400,850,1000,2000))+
  labs(x="Player 1 (v = 400)",y="Player 2 (v = 100)")+geom_hline(yintercept = 100,color="grey")+geom_hline(yintercept = 400,color="grey",linetype ="dashed")+geom_hline(yintercept = 850,color="grey",linetype ="dashed")+geom_hline(yintercept = 1000,color="grey",linetype ="dashed")+geom_vline(xintercept = 400,color="grey")+geom_vline(xintercept = 1000,color="grey",linetype ="dashed")+geom_vline(xintercept = 1150,color="grey",linetype ="dashed")+geom_vline(xintercept = 1600,color="grey",linetype ="dashed")+  geom_abline(intercept = 0, slope = 1,color="royalblue4")+  geom_abline(intercept = 0, slope = 1/4,color="seagreen")+ 
  geom_segment(aes(x = 400, y = 100, xend = 2000, yend = 1700),color="tomato")+geom_hline(yintercept = 0)+geom_vline(xintercept = 0)+geom_abline(intercept = 2000,slope=-1)+geom_vline(xintercept = 0)+
    theme(axis.text =element_text(size=rel(0.75)),axis.title=element_text(size=rel(1.25)),legend.position="right",legend.text = element_text(size=rel(1.25)),legend.title = element_text(size=rel(1.25)))+ theme(aspect.ratio=1)+
  geom_hline(yintercept=0)+geom_vline(xintercept=0)+geom_point(aes(shape=Legend), size = 5)+scale_shape_manual(values = c(15,16,17,18))+
  scale_color_manual(values = c("darkgrey","royalblue4","tomato", "seagreen"))+theme(axis.line = element_line(color = "black"),
    panel.border = element_blank(),
    panel.background = element_blank(),
    panel.grid = element_blank())

```
```{r}
#Setup data for analysis
data <- read.csv("C:/Users/vinht/Desktop/norm-abandon.csv")
head(data)

data$Disagree100<-data$Disagree/100
data$M100<-data$M/100
data$DisagreeDist <-data$Disagree-data$OthersDisagree
data$EffortDist <-data$Effort-data$OthersEffort
data$Tied<-ifelse(data$Effort==data$OthersEffort,1,0)
data$Profit<-ifelse(data$Type==0,data$ProfitNoBargaining,ifelse(data$Deal==1,data$Choice,data$Disagree))
data$OthersProfit<-ifelse(data$Type==0,data$M-data$ProfitNoBargaining,ifelse(data$Deal==1,data$OthersChoice,data$OthersDisagree))
data$Eff<-(data$Profit+data$OthersProfit)/data$M
data$Highcon<-ifelse(data$Disagree>301,1,0)

#Disagree100: initial endowment in unit of 100 yen
#DisagreeDist: distance in initial endowments
#EffortDist: distance in effort task performance
#Tied: whether tied with opponent in task performance
#Profit: what a subject earned at the end of each negotiation round
#OthersProfit: what the opponent earned at the end of each negotiation round
#Eff: efficiency of outcome; proportion of total payoff over M

data$EDpay<-data$M/2
data$EGpay<-(data$M-data$Disagree-data$OthersDisagree)/2+data$Disagree
data$PDpay<-data$M*data$Disagree/(data$Disagree+data$OthersDisagree)
data$Pay<-ifelse(data$Rule=="ED",data$EDpay,ifelse(data$Rule=="EG",data$EGpay,data$PDpay))

#EDpay: projected payoff for subject according to ED
#EGpay: projected payoff for subject according to EG
#PDpay: projected payoff for subject according to PD
#Pay: projected payoff for subject according to the chosen rule

data$EDotherspay<-data$M/2
data$EGotherspay<-(data$M-data$Disagree-data$OthersDisagree)/2+data$OthersDisagree
data$PDotherspay<-data$M*data$OthersDisagree/(data$Disagree+data$OthersDisagree)
data$Otherspay<-ifelse(data$Rule=="ED",data$EDotherspay,ifelse(data$Rule=="EG",data$EGotherspay,data$PDotherspay))

#EDotherspay: projected payoff for the opponent according to ED
#EGotherspay: projected payoff for the opponent according to EG
#PDotherspay: projected payoff for the opponent according to PD
#Otherspay: projected payoff for the opponent according to the chosen rule

data$ProjectedDiff<-data$Pay-data$Otherspay
#ProjectedDiff:  projected payoff distance between the subject and opponent according to the chosen rule

data$EDdist<-abs(data$Choice-data$EDpay)
data$EGdist<-abs(data$Choice-data$EGpay)
data$PDdist<-abs(data$Choice-data$PDpay)
data$EDclose<-ifelse(data$EDdist<data$EGdist&data$EDdist<data$PDdist,1,ifelse(data$EDdist==data$EGdist|data$EDdist==data$PDdist,1/2,0))
data$EGclose<-ifelse(data$EGdist<data$EDdist&data$EGdist<data$PDdist,1,ifelse(data$EGdist==data$EDdist|data$EGdist==data$PDdist,1/2,0))
data$PDclose<-ifelse(data$PDdist<data$EDdist&data$PDdist<data$EGdist,1,ifelse(data$PDdist==data$EDdist|data$PDdist==data$EGdist,1/2,0))

#EDdist: distance between ED projection and subject's demand in NDG/outcome in UB 
#EGdist: distance between EG projection and subject's demand in NDG/outcome in UB 
#PDdist: distance between PD projection and subject's demand in NDG/outcome in UB 
#EDclose: whether ED projection is closest to subject's demand in NDG/outcome in UB 
#EGclose: whether EG projection is closest to subject's demand in NDG/outcome in UB 
#PDclose: whether PD projection is closest to subject's demand in NDG/outcome in UB 
#When the outcome is exactly in the middle between two rules, each rule receives 1/2
  
datac<-data%>% filter(Period>2&(SID!=3206|SID!=4206|SID!=3222|SID!=4221))
datah<-data%>% filter(Disagree>OthersDisagree)
datal<-data%>% filter(Disagree<OthersDisagree)
databarg<-datac%>% filter(Period>2&Type==1)

#datac: clean data excluding 2 rounds of a subject that made unusually low demands and the paired opponent. This subsample is only needed when analyzing the individual demands/bargaining outcomes (Focus 3)
##Subject 705 was sick in the last 3 rounds (period 8-10) and the data was already excluded in the file.
#datah: data including only high performers in each pair
#datal: data including only low performers in each pair
#databarg: data inluding only bargaining rounds and subjects proceeding to bargaining

```
# Focus 1: preselection of norms
```{r}
#Selection rate of each norm
rate_rule_1 <- sum(data$Rule == "ED") / nrow(data)
rate_rule_2 <- sum(data$Rule == "EG") / nrow(data)
rate_rule_3 <- sum(data$Rule == "PD") / nrow(data)

# How many people, male, female choose each rule
subset_period1 <- subset(data, Period == 1)
subset_female <- subset(data, Gender == 1)
subset_male <- subset(data, Gender == 0)


rate_rule_1 <- sum(subset_period1$Rulecode == 1) / nrow(subset_period1)
rate_rule_2 <- sum(subset_period1$Rulecode == 2) / nrow(subset_period1)
rate_rule_3 <- sum(subset_period1$Rulecode == 3) / nrow(subset_period1)
male1 <- sum(subset_period1$Rulecode == 1 & subset_period1$Gender == 0)
male2 <- sum(subset_period1$Rulecode == 2 & subset_period1$Gender == 0)
male3 <- sum(subset_period1$Rulecode == 3 &subset_period1$Gender == 0)
female1 <- sum(subset_period1$Rulecode == 1 & subset_period1$Gender == 1)
female2 <- sum(subset_period1$Rulecode == 2 & subset_period1$Gender == 1)
female3 <- sum(subset_period1$Rulecode == 3 & subset_period1$Gender == 1)

```
```{r}
# Combined plot for rule selection (Figure 4)

rule_period1 <- data.frame(
  Gender=c("All","All","All","Female","Female","Female","Male","Male","Male"),
  Norm = c("Rule 1",  "Rule 2", "Rule 3","Rule 1",  "Rule 2", "Rule 3","Rule 1",  "Rule 2", "Rule 3"),
  Proportion = c(rate_rule_1,rate_rule_2,rate_rule_3,female1/sum(female1,female2,female3), female2/sum(female1,female2,female3), female3/sum(female1,female2,female3),male1/sum(male1,male2,male3), male2/sum(male1,male2,male3), male3/sum(male1,male2,male3)))

rule_period1$Percentage<-round(rule_period1$Proportion*100)


mosgen<-ggplot(rule_period1,
       aes(x = factor(Gender,level=c('All', 'Female', 'Male')), y = Proportion, fill = Norm)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mosgen+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("azure","lightblue","skyblue3"),labels=c("ED","EG","PD"))

```
```{r}
# Binomial tests for the difference between the selection rates
binom.test(sum(subset_period1$Rulecode == 1), nrow(subset_period1), p = 1/3)
binom.test(sum(subset_period1$Rulecode == 2), nrow(subset_period1), p = 1/3)
binom.test(sum(subset_period1$Rulecode == 3), nrow(subset_period1), p = 1/3)

```
```{r}
# Chi-square test for the difference from a uniform distribution (1/3,1/3,1/3)

observed <- c(sum(subset_period1$Rulecode == 1), sum(subset_period1$Rulecode == 2), sum(subset_period1$Rulecode == 3))  
chisq.test(x = observed, p = c(1/3, 1/3, 1/3))

```

```{r}
# Tests (Fisher, correlation) for gender effect in rule selection 
fisher_test_result <- fisher.test(subset_period1$Gender, subset_period1$Rulecode)
print(fisher_test_result)
subset_female$RuleCS<- ifelse(subset_female$Rule==2,1,0)
modelf <- aov(subset_female$Rulecode ~ subset_female$SubjectID, data = subset_female)
summary(modelf)
modelf2 <- aov(subset_female$RuleCS ~ subset_female$SubjectID, data = subset_female)
summary(modelf2)
modelm <- aov(subset_male$Rulecode ~ subset_male$SubjectID, data = subset_male)
summary(modelm)

cor.test(subset_period1$Rulecode, subset_period1$Gender, method = c("pearson", "kendall", "spearman"))

```
```{r}
# Simple logistic regression for gender effect in rule selection 
subset_period1$Rule1Dummy <- as.integer(subset_period1$Rulecode == 1)
subset_period1$Rule2Dummy <- as.integer(subset_period1$Rulecode == 2)
subset_period1$Rule3Dummy <- as.integer(subset_period1$Rulecode == 3)
loggender_ED <- glm(Rule1Dummy ~ Gender, data = subset_period1, family = "binomial")
summary(loggender_ED)
loggender_EG <- glm(Rule2Dummy ~ Gender, data = subset_period1, family = "binomial")
summary(loggender_EG)
loggender_PD <- glm(Rule3Dummy ~ Gender, data = subset_period1, family = "binomial")
summary(loggender_PD)
```
```{r} 
# Jonckheere test for correlation between selection and treatments 
subset_ND <- subset(data, Treatment == "N")
subset_NC <- subset(data, Treatment == "NC")
subset_UB <- subset(data, Treatment == "UB")
N1 <-sum(subset_period1$Rulecode == 1 & subset_period1$Treatment == "N")
N2 <-sum(subset_period1$Rulecode == 2 & subset_period1$Treatment == "N")
N3 <-sum(subset_period1$Rulecode == 3 & subset_period1$Treatment == "N")
NC1 <-sum(subset_period1$Rulecode == 1 & subset_period1$Treatment == "NC")
NC2 <-sum(subset_period1$Rulecode == 2 & subset_period1$Treatment == "NC")
NC3 <-sum(subset_period1$Rulecode == 3 & subset_period1$Treatment == "NC")
UB1 <-sum(subset_period1$Rulecode == 1 & subset_period1$Treatment == "UB")
UB2 <-sum(subset_period1$Rulecode == 2 & subset_period1$Treatment == "UB")
UB3 <-sum(subset_period1$Rulecode == 3 & subset_period1$Treatment == "UB")

treatment_group <- factor(c(rep("N", N1 + N2 + N3), rep("NC", NC1 + NC2 + NC3), rep("UB", UB1 + UB2 + UB3)), ordered = TRUE)

rule_selections <- c(rep(1, N1), rep(2, N2), rep(3, N3),
                     rep(1, NC1), rep(2, NC2), rep(3, NC3),
                     rep(1, UB1), rep(2, UB2), rep(3, UB3))

jonckheere.test(rule_selections, treatment_group, alternative = "increasing")

jonckheere.test(rule_selections, treatment_group, alternative = "decreasing")

```
```{r}
# Fisher's exact test for correlation between selection and treatments 
contingency_table <- matrix(c(N1, N2, N3,
                              NC1, NC2, NC3,
                              UB1, UB2, UB3),
                            nrow = 3,
                            byrow = TRUE,
                            dimnames = list(Treatment = c("N", "NC", "UB"),
                                            Rule = c("Rule 1", "Rule 2", "Rule 3")))


fisher.test(contingency_table)
```

```{r}
# Tests for relationship between norm selection and effort task score
subset_period2 <- subset(data, Period == 2)

anova_result <- aov(Effort ~ factor(Rule), data = subset_period2)
summary(anova_result)

tukey_test_result <- TukeyHSD(anova_result, "factor(Rule)", ordered = FALSE)
print(tukey_test_result)


pairwise_t_test_result <- pairwise.t.test(subset_period2$Effort, subset_period2$Rulecode)
print(pairwise_t_test_result)

mean_effort_per_rule <- aggregate(Effort ~ Rulecode, data = subset_period2, FUN = mean)

colors <- c("red", "blue", "green")


boxplot(Effort ~ factor(Rule), data = subset_period2,
        xlab = "Norm",
        ylab = "Task score",
        col = c("azure","lightblue","skyblue3"))
```

```{r}

subsetED <- subset(data, Rulecode == 1)
subsetEG <- subset(data, Rulecode == 2)
subsetPD <- subset(data, Rulecode == 3)

effort_rates <- c(subsetED$Effort, subsetEG$Effort, subsetPD$Effort)
treatment_group <- factor(c(rep(1, nrow(subsetED)), rep(2, nrow(subsetEG)), rep(3, nrow(subsetPD))), ordered = TRUE)

jonckheere.test(effort_rates, treatment_group, alternative = "increasing")
```
# Focus 2: Decision when matched with someone holding the same norm
```{r}
#Create sample of all subjects sharing the same norm
subset_samenorm <- subset(data, Period >= 3 & SameNorm == 1) 

#Create subsamples of all subjects sharing the same norm by treatment
subset_samenormNN <- subset(subset_samenorm, Treatment == "N")
subset_samenormNC <- subset(subset_samenorm, Treatment == "NC")
subset_samenormUB <- subset(subset_samenorm, Treatment == "UB")

#Create subsamples of all subjects sharing the same norm and decide to proceed to bargaining, by treatment
bargainNN<-sum(subset_samenormNN$Decision==1)
bargainNC<-sum(subset_samenormNC$Decision==1)
bargainUB<-sum(subset_samenormUB$Decision==1)

#Create subsamples of all subjects sharing the same norm by selected norm
subset_samenormES <- subset(subset_samenorm, Rulecode == 1)
subset_samenormCS <- subset(subset_samenorm, Rulecode == 2)
subset_samenormPS <- subset(subset_samenorm, Rulecode == 3)

#Create subsamples of all subjects sharing the same norm and decide to proceed to bargaining, by selected norm
bargainES<-sum(subset_samenormES$Decision==1)
bargainCS<-sum(subset_samenormCS$Decision==1)
bargainPS<-sum(subset_samenormPS$Decision==1)
```

```{r}
# Plot for bargaining initiation by norm (Figure 5A)
rulebargain <- data.frame(
  Rule=c("ED","ED","EG","EG","PD","PD"),
  Bargain = c("Yes",  "No", "Yes",  "No","Yes",  "No"),
  Proportion = c(bargainES/nrow(subset_samenormES),1-bargainES/nrow(subset_samenormES),bargainCS/nrow(subset_samenormCS),1-bargainCS/nrow(subset_samenormCS),bargainPS/nrow(subset_samenormPS),1-bargainPS/nrow(subset_samenormPS)))

rulebargain$Percentage<-round(rulebargain$Proportion*100)


mostrule<-ggplot(rulebargain,
       aes(x = factor(Rule,level=c("ED","EG","PD")), y = Proportion, fill = Bargain)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()

mostrule2<-mostrule+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("#F0E2E2","#F08080"),labels=c('No','Yes'))+
            labs(title="(a) By norm")
mostrule2
```
```{r}
# Plot for bargaining initiation by treatment (Figure 5B)
tmbargain <- data.frame(
  Treatment=c("N","N","NC","NC","UB","UB"),
  Bargain = c("Yes",  "No", "Yes",  "No","Yes",  "No"),
  Proportion = c(bargainNN/nrow(subset_samenormNN),1-bargainNN/nrow(subset_samenormNN),bargainNC/nrow(subset_samenormNC),1-bargainNC/nrow(subset_samenormNC),bargainUB/nrow(subset_samenormUB),1-bargainUB/nrow(subset_samenormUB)))

tmbargain$Percentage<-round(tmbargain$Proportion*100)


mostm<-ggplot(tmbargain,
       aes(x = factor(Treatment,level=c('N','NC','UB')), y = Proportion, fill = Bargain)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostm2<-mostm+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("#F0E2E2","#F08080"),labels=c('No','Yes'))+
            labs(title="(b) By treatment")
mostm2
```
```{r}
# Plot for bargaining initiation across norms and periods (Figure C.2A)
data %>%
  filter(Period >= 3,SameNorm==1) %>% 
  group_by(Rule, Period) %>% 
  summarise(meanini = mean(Decision*100)) %>% 
  mutate(
  Rule = as.factor(Rule)
) %>%
  ggplot(aes(x = Period, y = meanini, color = Rule)) +
  scale_color_manual(values = c("royalblue4","tomato", "seagreen"))+
  scale_x_continuous(breaks = seq(3, 10, by = 1), labels = seq(1, 8, by = 1))+theme_bw()+geom_point(aes(shape=Rule), size = 3)+scale_y_continuous(limits=c(0,100))+
  geom_line() + labs(x="",y="")+
    theme(axis.text =element_text(size=rel(1.25)),axis.title=element_text(size=rel(1.5)),legend.position="right",legend.text = element_text(size=rel(1.5)),legend.title = element_text(size=rel(1.5)))
```



```{r}
# Plot for bargaining initiation across treatments and periods (Figure C.2B)
data %>%
  filter(Period >= 3,SameNorm==1) %>% 
  group_by(Treatment, Period) %>% 
  summarise(meanini = mean(Decision*100)) %>% 
  mutate(
  Treatment = as.factor(Treatment)
) %>%
  ggplot(aes(x = Period, y = meanini, color = Treatment)) +scale_color_manual(values = c("steelblue4","salmon", "darkgreen"), 
                     labels = c("N", "NC","UB"))+
  scale_x_continuous(breaks = seq(3, 10, by = 1), labels = seq(1, 8, by = 1))+theme_bw()+geom_point(aes(shape=Treatment), size = 3)+scale_y_continuous(limits=c(0,100))+
  geom_line() + labs(x="",y="")+
    theme(axis.text =element_text(size=rel(1.25)),axis.title=element_text(size=rel(1.5)),legend.position="right",legend.text = element_text(size=rel(1.5)),legend.title = element_text(size=rel(1.5)))

```

# Regression analysis
```{r}
#Setting up sample of subjects sharing the same norm and subsamples by chosen rule
subset_samenorm <- subset(data, Period >= 3 & SameNorm == 1)
subset_samenorm1 <- subset(subset_samenorm, Rulecode == 1)
subset_samenorm2 <- subset(subset_samenorm, Rulecode == 2)
subset_samenorm3 <- subset(subset_samenorm, Rulecode == 3)

#High investors only
subset_samenormh <- subset(datah, Period >= 3 & SameNorm == 1)
subset_samenorm1h <- subset(datah, Period >= 3 & SameNorm == 1 & Rulecode == 1)
subset_samenorm2h <- subset(datah, Period >= 3 & SameNorm == 1 & Rulecode == 2)
subset_samenorm3h <- subset(datah, Period >= 3 & SameNorm == 1 & Rulecode == 3)

#Low investors only
subset_samenorml <- subset(datal, Period >= 3 & SameNorm == 1)
subset_samenorm1l <- subset(datal, Period >= 3 & SameNorm == 1 & Rulecode == 1)
subset_samenorm2l <- subset(datal, Period >= 3 & SameNorm == 1 & Rulecode == 2)
subset_samenorm3l <- subset(datal, Period >= 3 & SameNorm == 1 & Rulecode == 3)
```

```{r}
#Tables 1, B.2

regED_lpm2 <- lmer(Decision ~ Highcon + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorm1, REML=FALSE) 

regEG_lpm2 <- lmer(Decision ~ Highcon + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorm2, REML=FALSE) 

regPD_lpm2 <- lmer(Decision ~ Highcon + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorm3, REML=FALSE) 

regAll_lpm2 <- lmer(Decision ~ Highcon*Rulename + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorm, REML=FALSE) 


CombiLog1 <- list(regED_lpm2,regEG_lpm2,regPD_lpm2,regAll_lpm2)
stargazer(CombiLog1,
          dep.var.caption = "Initiate bargaining",
          notes.label = "Significance level",
          column.labels=c("ED","EG","PD","All","All"),

          type = "text",
          keep.stat = c("n", "rsq")
          )

```

```{r}
#Change NC as base treatment in Model 4 (Table B.2)

regAll_lpm2 <- lmer(Decision ~ Highcon*Rulename + relevel(as.factor(Treatment), ref = "NC")+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorm, REML=FALSE) 

CombiLog2 <- list(regAll_lpm2)
stargazer(CombiLog2,
          dep.var.caption = "Initiate bargaining",
          notes.label = "Significance level",
          type = "text",
          keep.stat = c("n", "rsq")
          )
```
```{r}
#Table B.3


regAll_lpm <- lmer(Decision ~ Disagree100*Rulename + Treatment+(1|SubjectID), data = subset_samenorm, REML=FALSE) 

regAll_log <- glmer(Decision ~ Disagree100*Rulename + Treatment +(1|SubjectID), data = subset_samenorm, family="binomial")  

CombiLog1 <- list(regAll_lpm,regAll_log)
stargazer(CombiLog1,
          dep.var.caption = "Initiate bargaining",
          notes.label = "Significance level",

          type = "text",
          keep.stat = c("n", "rsq")
          )

```

```{r}
#Margins for logistic vs linear

marginal_effects_All_lpm <- margins(regAll_lpm)
marginal_effects_All_log <- margins(regAll_log)

summary(marginal_effects_All_lpm)
summary(marginal_effects_All_log)

```


```{r}
#Table 2, B.2

regHigh_lpm <- lmer(Decision ~ Disagree100*Rulename + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenormh, REML=FALSE) 

regLow_lpm <- lmer(Decision ~ Disagree100*Rulename + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorml, REML=FALSE) 

regAll_lpm2 <- lmer(Decision ~ Disagree100*Rulename + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorm, REML=FALSE) 


CombiLog3 <- list(regHigh_lpm,regLow_lpm,regAll_lpm2)
stargazer(CombiLog3,
          dep.var.caption = "Initiate bargaining",
          notes.label = "Significance level",
          column.labels=c("High","Low"),

          type = "text",
          keep.stat = c("n", "rsq")
          )
```
```{r}
#Change base norm to EG (Table B.2)

regHigh_lpm <- lmer(Decision ~ Disagree100*relevel(as.factor(Rulename), ref = "EG") + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenormh, REML=FALSE) 

regLow_lpm <- lmer(Decision ~ Disagree100*relevel(as.factor(Rulename), ref = "EG") + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorml, REML=FALSE) 

CombiLog3 <- list(regHigh_lpm,regLow_lpm)
stargazer(CombiLog3,
          dep.var.caption = "Initiate bargaining",
          notes.label = "Significance level",
          column.labels=c("High","Low"),

          type = "text",
          keep.stat = c("n", "rsq")
          )
```
```{r}
#•	Change base norm to PD (Table B.2)

regHigh_lpm <- lmer(Decision ~ Disagree100*relevel(as.factor(Rulename), ref = "PD") + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenormh, REML=FALSE) 

regLow_lpm <- lmer(Decision ~ Disagree100*relevel(as.factor(Rulename), ref = "PD") + Treatment+M100+ Failexp+ Tied+ TimeEffortMin+Period + Gender + Risk +(1|SubjectID), data = subset_samenorml, REML=FALSE) 

CombiLog3 <- list(regHigh_lpm,regLow_lpm)
stargazer(CombiLog3,
          dep.var.caption = "Initiate bargaining",
          notes.label = "Significance level",
          column.labels=c("High","Low"),

          type = "text",
          keep.stat = c("n", "rsq")
          )
```
```{r}
#Table 3
df <- group_by(subset_samenorm, Disagree100, Rulename)
df <- summarise(df, avg = mean(Decision))
df
```
```{r}
#Table B.1
subset_period1 %>%
  group_by(Session, Treatment) %>%
  summarize(subject_count = n_distinct(SubjectID), .groups = "drop")
```

# Efficiency
```{r}
#Setup subsamples for bargaining pairs by treatment
subset_bargNN <- subset(databarg,Treatment == "N")
subset_bargNC <- subset(databarg,Treatment == "NC")
subset_bargUB <- subset(databarg,Treatment == "UB")

#Setup subsamples for bargaining pairs who reach a deal by treatment
dealNN<-sum(subset_bargNN$Deal==1)
dealNC<-sum(subset_bargNC$Deal==1)
dealUB<-sum(subset_bargUB$Deal==1)

#Calculate bargaining efficiency (proportion of final payoffs in total pie) by treatments
effNN<-mean(subset_bargNN$Eff)
effNC<-mean(subset_bargNC$Eff)
effUB<-mean(subset_bargUB$Eff)

#Setup subsamples to analyze bargaining outcomes by treatment
subset_NN <- subset(datac,Treatment == "N")
subset_NC <- subset(datac,Treatment == "NC")
subset_UB <- subset(datac,Treatment == "UB")

#Calculate overall efficiency (proportion of final payoffs in total pie) by treatments
alleffNN<-mean(subset_NN$Eff)
alleffNC<-mean(subset_NC$Eff)
alleffUB<-mean(subset_UB$Eff)

```
```{r}
#Graph for bargaining deals by treatment (Figure 6a)
tmdeal <- data.frame(
  Treatment=c("N","N","NC","NC","UB","UB"),
  Deal = c("Yes",  "No", "Yes",  "No","Yes",  "No"),
  Proportion = c(dealNN/nrow(subset_bargNN),1-dealNN/nrow(subset_bargNN),dealNC/nrow(subset_bargNC),1-dealNC/nrow(subset_bargNC),dealUB/nrow(subset_bargUB),1-dealUB/nrow(subset_bargUB)))

tmdeal$Percentage<-round(tmdeal$Proportion*100)


mostm<-ggplot(tmdeal,
       aes(x = factor(Treatment,level=c('N','NC','UB')), y = Proportion, fill = Deal)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostm+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("#e8f4ea","#88bd91"),labels=c('No','Yes'))

```
```{r}
#Plot for payoff efficiency across treatment (Figure 6B)
tmpayoff <- data.frame(
  Treatment=c("N","N","NC","NC","UB","UB"),
  Payoff = c("Yes",  "No", "Yes",  "No","Yes",  "No"),
  Proportion = c(alleffNN,1-alleffNN,alleffNC,1-alleffNC,alleffUB,1-alleffUB))

tmpayoff$Percentage<-round(tmpayoff$Proportion*100)


mostm<-ggplot(tmpayoff,
       aes(x = factor(Treatment,level=c('N','NC','UB')), y = Proportion, fill = Payoff)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostm+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_blank(),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("#e8f4ea","#88bd91"),labels=c('Leftover','Payoffs'))

```

```{r}
#Plot for payoff efficiency of bargaining pairs only 
tmpayoff <- data.frame(
  Treatment=c("N","N","NC","NC","UB","UB"),
  Payoff = c("Yes",  "No", "Yes",  "No","Yes",  "No"),
  Proportion = c(effNN,1-effNN,effNC,1-effNC,effUB,1-effUB))

tmpayoff$Percentage<-round(tmpayoff$Proportion*100)


mostm<-ggplot(tmpayoff,
       aes(x = factor(Treatment,level=c('N','NC','UB')), y = Proportion, fill = Payoff)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostm+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_blank(),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("#e8f4ea","#88bd91"),labels=c('Leftover','Payoffs'))

```
```{r}
# Plot for bargaining agreements across periods (Figure C.3)
databarg %>%
  group_by(Treatment, Period) %>% 
  summarise(meansuccess = mean(Deal*100)) %>% 
  mutate(
  Treatment = as.factor(Treatment)
) %>%
  ggplot(aes(x = Period, y = meansuccess, color = Treatment)) +scale_color_manual(values = c("steelblue4","salmon", "darkgreen"), 
                     labels = c("N", "NC","UB"))+
  scale_x_continuous(breaks = seq(3, 10, by = 1), labels = seq(1, 8, by = 1))+theme_bw()+geom_point(aes(shape=Treatment), size = 3)+scale_y_continuous(limits=c(0,100))+
  geom_line() + labs(y="",x="")+
    theme(axis.text =element_text(size=rel(1.25)),axis.title=element_text(size=rel(1.5)),legend.position="right",legend.text = element_text(size=rel(1.5)),legend.title = element_text(size=rel(1.5)))

```

```{r}
# Plot for the payoff efficiency across periods (Figure C.4A)
datac %>%
  filter(Period >= 3) %>% 
  group_by(Treatment, Period) %>% 
  summarise(meanefficiency = mean(Eff*100)) %>% 
  mutate(
  Treatment = as.factor(Treatment)
) %>%
  ggplot(aes(x = Period, y = meanefficiency, color = Treatment))+scale_color_manual(values = c("steelblue4","salmon", "darkgreen"), 
                     labels = c("N", "NC","UB"))+
  scale_x_continuous(breaks = seq(3, 10, by = 1), labels = seq(1, 8, by = 1))+theme_bw()+geom_point(aes(shape=Treatment), size = 3)+scale_y_continuous(limits=c(0,100))+
  geom_line() + labs(y="",x="")+theme(axis.text =element_text(size=rel(1.25)),axis.title=element_text(size=rel(1.5)),legend.position="right",legend.text = element_text(size=rel(1.5)),legend.title = element_text(size=rel(1.5)))
```
```{r}
# Plot for the payoff efficiency across periods for bargaining pairs (Figure C.4b)
databarg %>%
  group_by(Treatment, Period) %>% 
  summarise(meanefficiency = mean(Eff*100)) %>% 
  mutate(
  Treatment = as.factor(Treatment)
) %>%
  ggplot(aes(x = Period, y = meanefficiency, color = Treatment)) +scale_color_manual(values = c("steelblue4","salmon", "darkgreen"), 
                     labels = c("N", "NC","UB"))+
  scale_x_continuous(breaks = seq(3, 10, by = 1), labels = seq(1, 8, by = 1))+theme_bw()+geom_point(aes(shape=Treatment), size = 3)+scale_y_continuous(limits=c(0,100))+
  geom_line() + labs(y="",x="")+    theme(axis.text =element_text(size=rel(1.25)),axis.title=element_text(size=rel(1.5)),legend.position="right",legend.text = element_text(size=rel(1.5)),legend.title = element_text(size=rel(1.5)))

```


```{r}
subsetbarg_N <- subset(databarg,Treatment == "N")
subsetbarg_NC <- subset(databarg,Treatment == "NC")
subsetbarg_UB <- subset(databarg,Treatment == "UB")
```

```{r}
# Jonckheere  test for difference in deal rate of 3 samples


selection_rates <- c(subsetbarg_N$Deal, subsetbarg_NC$Deal, subsetbarg_UB$Deal)
treatment_group <- factor(c(rep(1, nrow(subsetbarg_N)), rep(2, nrow(subsetbarg_NC)), rep(3, nrow(subsetbarg_UB))), ordered = TRUE)

jonckheere.test(selection_rates, treatment_group, alternative = "increasing")
```



```{r}
# Jonckheere  test for difference in efficiency (final payoffs as proportion of pie) of 3 samples

eff_rates <- c(subset_NN$Eff, subset_NC$Eff, subset_UB$Eff)
treatment_group <- factor(c(rep(1, nrow(subset_NN)), rep(2, nrow(subset_NC)), rep(3, nrow(subset_UB))), ordered = TRUE)

jonckheere.test(eff_rates, treatment_group, alternative = "increasing")

## For bargaining pairs only

eff_ratesbarg <- c(subsetbarg_N$Eff, subsetbarg_NC$Eff, subsetbarg_UB$Eff)
treatment_group <- factor(c(rep(1, nrow(subsetbarg_N)), rep(2, nrow(subsetbarg_NC)), rep(3, nrow(subsetbarg_UB))), ordered = TRUE)

jonckheere.test(eff_ratesbarg, treatment_group, alternative = "increasing")

```
# Bargaining outcomes alignment
```{r}
#Setting up subsamples for subjects proceeding to bargaining

subset_ED <- subset(databarg, Rulecode == 1) #all subjects proceeding to bargaining that preselected ED 
subset_EG <- subset(databarg, Rulecode == 2) #all subjects proceeding to bargaining that preselected EG 
subset_PD <- subset(databarg, Rulecode == 3) #all subjects proceeding to bargaining that preselected PD 

subset_N<-databarg %>% filter(Treatment=="N"|Treatment=="NC") #all NDG subjects proceeding to bargaining
subset_EDN <-subset_ED %>% filter(Treatment=="N"|Treatment=="NC") #all NDG subjects proceeding to bargaining that preselected ED 
subset_EGN<-subset_EG %>% filter(Treatment=="N"|Treatment=="NC") #all NDG subjects proceeding to bargaining  that preselected EG
subset_PDN<-subset_PD %>% filter(Treatment=="N"|Treatment=="NC") #all NDG subjects proceeding to bargaining  that preselected PD
```
```{r}
#Samples for subjects proceeding to bargaining in the NDG treatments, divided by the preselected rules

N_outcomeED<-sum(subset_N$EDclose) #Sum of cases that ended up demanding close to ED
N_outcomeEG<-sum(subset_N$EGclose) #Sum of cases that ended up demanding close to EG
N_outcomePDD<-sum(subset_N$PDclose) #Sum of cases that ended up demanding close to PD


EDN_outcomeED<-sum(subset_EDN$EDclose) #Sum of cases preselecting ED that ended up demanding close to ED
EDN_outcomeEG<-sum(subset_EDN$EGclose) #Sum of cases preselecting ED that ended up demanding close to EG
EDN_outcomePD<-sum(subset_EDN$PDclose) #Sum of cases preselecting ED that ended up demanding close to PD


EGN_outcomeED<-sum(subset_EGN$EDclose) #Sum of cases preselecting EG that ended up demanding close to ED
EGN_outcomeEG<-sum(subset_EGN$EGclose) #Sum of cases preselecting EG that ended up demanding close to EG
EGN_outcomePD<-sum(subset_EGN$PDclose) #Sum of cases preselecting EG that ended up demanding close to PD

PDN_outcomeED<-sum(subset_PDN$EDclose) #Sum of cases preselecting PD that ended up demanding close to ED
PDN_outcomeEG<-sum(subset_PDN$EGclose) #Sum of cases preselecting PD that ended up demanding close to EG
PDN_outcomePD<-sum(subset_PDN$PDclose) #Sum of cases preselecting PD that ended up demanding close to PD


```
```{r}
#Samples for subjects proceeding to bargaining in the UB treatment, divided by the preselected rules
subset_UBdeal<-databarg %>% filter(Treatment=="UB"&Deal==1)
subset_EDU<-subset_ED %>% filter(Treatment=="UB")
subset_EGU<-subset_EG %>% filter(Treatment=="UB")
subset_PDU<-subset_PD %>% filter(Treatment=="UB")

U_outcomeED<-sum(subset_UBdeal$EDclose) #Sum of cases that ended up demanding close to ED
U_outcomeEG<-sum(subset_UBdeal$EGclose) #Sum of cases that ended up demanding close to EG
U_outcomePD<-sum(subset_UBdeal$PDclose) #Sum of cases that ended up demanding close to PD

EDU_outcomeED<-sum(subset_EDU$EDclose) #Sum of cases preselecting ED that ended up demanding close to ED
EDU_outcomeEG<-sum(subset_EDU$EGclose) #Sum of cases preselecting ED that ended up demanding close to EG
EDU_outcomePD<-sum(subset_EDU$PDclose) #Sum of cases preselecting ED that ended up demanding close to PD

EGU_outcomeED<-sum(subset_EGU$EDclose) #Sum of cases preselecting EG that ended up demanding close to ED
EGU_outcomeEG<-sum(subset_EGU$EGclose) #Sum of cases preselecting EG that ended up demanding close to EG
EGU_outcomePD<-sum(subset_EGU$PDclose) #Sum of cases preselecting EG that ended up demanding close to PD

PDU_outcomeED<-sum(subset_PDU$EDclose) #Sum of cases preselecting PD that ended up demanding close to ED
PDU_outcomeEG<-sum(subset_PDU$EGclose) #Sum of cases preselecting PD that ended up demanding close to EG
PDU_outcomePD<-sum(subset_PDU$PDclose) #Sum of cases preselecting PD that ended up demanding close to PD

```

```{r}
# Plot for personal demands by rule for NDG (Figure 7a)

ruledemand <- data.frame(
  Rule=c("All","All","All", "ED","ED","ED","EG","EG","EG","PD","PD","PD"),
  Demand = c("ED",  "EG", "PD","ED",  "EG", "PD",  "ED",  "EG", "PD","ED",  "EG", "PD"),
  Proportion = c(N_outcomeED/nrow(subset_N),N_outcomeEG/nrow(subset_N),N_outcomePDD/nrow(subset_N),
                 EDN_outcomeED/nrow(subset_EDN),EDN_outcomeEG/nrow(subset_EDN),EDN_outcomePD/nrow(subset_EDN),
                 EGN_outcomeED/nrow(subset_EGN),EGN_outcomeEG/nrow(subset_EGN),EGN_outcomePD/nrow(subset_EGN),
                 PDN_outcomeED/nrow(subset_PDN),PDN_outcomeEG/nrow(subset_PDN),PDN_outcomePD/nrow(subset_PDN)))

ruledemand$Percentage<-round(ruledemand$Proportion*100)


mostrule<-ggplot(ruledemand,
       aes(x = factor(Rule,level=c('All',"ED","EG","PD")), y = Proportion, fill = Demand)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostrule+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("azure","lightblue","skyblue3"),labels=c("ED","EG","PD"))

```
```{r}
# Plot for personal outcome by original rule for UB (Figure 7b)

ruleoutcome <- data.frame(
  Rule=c("All","All","All", "ED","ED","ED","EG","EG","EG","PD","PD","PD"),
  Outcome = c("ED",  "EG", "PD", "ED",  "EG", "PD",  "ED",  "EG", "PD","ED",  "EG", "PD"),
  Proportion = c(U_outcomeED/nrow(subset_UBdeal),U_outcomeEG/nrow(subset_UBdeal),U_outcomePD/nrow(subset_UBdeal),
                 EDU_outcomeED/nrow(subset_EDU),EDU_outcomeEG/nrow(subset_EDU),EDU_outcomePD/nrow(subset_EDU),
                 EGU_outcomeED/nrow(subset_EGU),EGU_outcomeEG/nrow(subset_EGU),EGU_outcomePD/nrow(subset_EGU),
                 PDU_outcomeED/nrow(subset_PDU),PDU_outcomeEG/nrow(subset_PDU),PDU_outcomePD/nrow(subset_PDU)))

ruleoutcome$Percentage<-round(ruleoutcome$Proportion*100)


mostrule<-ggplot(ruleoutcome,
       aes(x = factor(Rule,level=c('All',"ED","EG","PD")), y = Proportion, fill = Outcome)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostrule+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("azure","lightblue","skyblue3"),labels=c("ED","EG","PD"))

```

```{r}
# Chi-squared, binomial tests for outcomes of NDG demands
binom.test(round(N_outcomeED), nrow(subset_N), p = 1/3)
binom.test(round(N_outcomeEG), nrow(subset_N), p = 1/3)
binom.test(round(N_outcomePDD), nrow(subset_N), p = 1/3)

observed <- c(sum(subset_N$EDclose == 1), sum(subset_N$EGclose == 1), sum(subset_N$PDclose == 1))  
chisq.test(x = observed, p = c(1/3, 1/3, 1/3))
```
```{r}
# Chi-squared, binomial tests for outcome of unstructured bargaining agreements
binom.test(round(U_outcomeED), nrow(subset_UBdeal), p = 1/3)
binom.test(round(U_outcomeEG), nrow(subset_UBdeal), p = 1/3)
binom.test(round(U_outcomePD), nrow(subset_UBdeal), p = 1/3)

observed <- c(sum(subset_UBdeal$EDclose == 1), sum(subset_UBdeal$EGclose == 1), sum(subset_UBdeal$PDclose == 1))  
chisq.test(x = observed, p = c(1/3, 1/3, 1/3))
```

```{r}
# Setup sample for NDG in same-norm pairs overall and subsamples by initial norms
subset_NS<-subset_N %>% filter(SameNorm==1) 
subset_EDNS<-subset_EDN %>% filter(SameNorm==1) 
subset_EGNS<-subset_EGN %>% filter(SameNorm==1)
subset_PDNS<-subset_PDN %>% filter(SameNorm==1)

NS_outcomeED<-sum(subset_NS$EDclose) #Sum of cases that ended up demanding close to ED
NS_outcomeEG<-sum(subset_NS$EGclose) #Sum of cases that ended up demanding close to EG
NS_outcomePD<-sum(subset_NS$PDclose) #Sum of cases that ended up demanding close to PD


EDNS_outcomeED<-sum(subset_EDNS$EDclose) #Sum of cases preselecting ED that ended up demanding close to ED
EDNS_outcomeEG<-sum(subset_EDNS$EGclose) #Sum of cases preselecting ED that ended up demanding close to EG
EDNS_outcomePD<-sum(subset_EDNS$PDclose) #Sum of cases preselecting ED that ended up demanding close to PD


EGNS_outcomeED<-sum(subset_EGNS$EDclose) #Sum of cases preselecting EG that ended up demanding close to ED
EGNS_outcomeEG<-sum(subset_EGNS$EGclose) #Sum of cases preselecting EG that ended up demanding close to EG
EGNS_outcomePD<-sum(subset_EGNS$PDclose) #Sum of cases preselecting EG that ended up demanding close to PD

PDNS_outcomeED<-sum(subset_PDNS$EDclose) #Sum of cases preselecting PD that ended up demanding close to ED
PDNS_outcomeEG<-sum(subset_PDNS$EGclose) #Sum of cases preselecting PD that ended up demanding close to EG
PDNS_outcomePD<-sum(subset_PDNS$PDclose) #Sum of cases preselecting PD that ended up demanding close to PD


```
```{r}
# Plot for personal demands by rule, for NDG, same norm (Figure C.5a)

ruledemand <- data.frame(
  Rule=c("All","All","All", "ED","ED","ED","EG","EG","EG","PD","PD","PD"),
  Demand = c("ED",  "EG", "PD","ED",  "EG", "PD",  "ED",  "EG", "PD","ED",  "EG", "PD"),
  Proportion = c(NS_outcomeED/nrow(subset_NS),NS_outcomeEG/nrow(subset_NS),NS_outcomePD/nrow(subset_NS),
                 EDNS_outcomeED/nrow(subset_EDNS),EDNS_outcomeEG/nrow(subset_EDNS),EDNS_outcomePD/nrow(subset_EDNS),
                 EGNS_outcomeED/nrow(subset_EGNS),EGNS_outcomeEG/nrow(subset_EGNS),EGNS_outcomePD/nrow(subset_EGNS),
                 PDNS_outcomeED/nrow(subset_PDNS),PDNS_outcomeEG/nrow(subset_PDNS),PDNS_outcomePD/nrow(subset_PDNS)))

ruledemand$Percentage<-round(ruledemand$Proportion*100)


mostrule<-ggplot(ruledemand,
       aes(x = factor(Rule,level=c('All',"ED","EG","PD")), y = Proportion, fill = Demand)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostrule+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("azure","lightblue","skyblue3"),labels=c("ED","EG","PD"))

```

```{r}
# Setup sample for UB in same-norm pairs overall and subsamples by initial norms
subset_US<-databarg %>% filter(Treatment=="UB",Deal==1,SameNorm=="1")
subset_EDUS<-subset_ED %>% filter(Treatment=="UB",Deal==1,SameNorm=="1")
subset_EGUS<-subset_EG %>% filter(Treatment=="UB",Deal==1,SameNorm=="1")
subset_PDUS<-subset_PD %>% filter(Treatment=="UB",Deal==1,SameNorm=="1")

US_outcomeED<-sum(subset_US$EDclose) #Sum of cases that ended up demanding close to ED
US_outcomeEG<-sum(subset_US$EGclose) #Sum of cases that ended up demanding close to EG
US_outcomePD<-sum(subset_US$PDclose) #Sum of cases that ended up demanding close to PD

EDUS_outcomeED<-sum(subset_EDUS$EDclose) #Sum of cases preselecting ED that ended up demanding close to ED
EDUS_outcomeEG<-sum(subset_EDUS$EGclose) #Sum of cases preselecting ED that ended up demanding close to EG
EDUS_outcomePD<-sum(subset_EDUS$PDclose) #Sum of cases preselecting ED that ended up demanding close to PD

EGUS_outcomeED<-sum(subset_EGUS$EDclose) #Sum of cases preselecting EG that ended up demanding close to ED
EGUS_outcomeEG<-sum(subset_EGUS$EGclose) #Sum of cases preselecting EG that ended up demanding close to EG
EGUS_outcomePD<-sum(subset_EGUS$PDclose) #Sum of cases preselecting EG that ended up demanding close to PD

PDUS_outcomeED<-sum(subset_PDUS$EDclose) #Sum of cases preselecting PD that ended up demanding close to ED
PDUS_outcomeEG<-sum(subset_PDUS$EGclose) #Sum of cases preselecting PD that ended up demanding close to EG
PDUS_outcomePD<-sum(subset_PDUS$PDclose) #Sum of cases preselecting PD that ended up demanding close to PD
```

```{r}
# Plot for personal outcome by rule for UB, only pairs the select the same norm (Figure C.5b)

ruleoutcome <- data.frame(
  Rule=c("All","All","All", "ED","ED","ED","EG","EG","EG","PD","PD","PD"),
  Outcome = c("ED",  "EG", "PD", "ED",  "EG", "PD",  "ED",  "EG", "PD","ED",  "EG", "PD"),
  Proportion = c(US_outcomeED/nrow(subset_US),US_outcomeEG/nrow(subset_US),US_outcomePD/nrow(subset_US),
EDUS_outcomeED/nrow(subset_EDUS),EDUS_outcomeEG/nrow(subset_EDUS),EDUS_outcomePD/nrow(subset_EDUS),
                 EGUS_outcomeED/nrow(subset_EGUS),EGUS_outcomeEG/nrow(subset_EGUS),EGUS_outcomePD/nrow(subset_EGUS),
                 PDUS_outcomeED/nrow(subset_PDUS),PDUS_outcomeEG/nrow(subset_PDUS),PDUS_outcomePD/nrow(subset_PDUS)))

ruleoutcome$Percentage<-round(ruleoutcome$Proportion*100)


mostrule<-ggplot(ruleoutcome,
       aes(x = factor(Rule,level=c('All',"ED","EG","PD")), y = Proportion, fill = Outcome)) +
geom_col(colour = "black",width = 0.75) +
geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5),size=rel(10)) + 
theme_void()
mostrule+theme(axis.text.x=element_text(size=rel(2)),legend.title= element_text(size=rel(2)),legend.text = element_text(size=rel(2)))+scale_fill_manual(values=c("azure","lightblue","skyblue3"),labels=c("ED","EG","PD"))

#For UB pairs that share the ED norm the sample is too small to be meaningful
```

